COMMENT ⊗   VALID 00015 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	.TITLE FUNCTS
C00006 00003	"HERE"   - COMMAND INSTRUCTION
C00007 00004	"POINT"  - COMMAND INSTRUCTION
C00009 00005	"WHERE"  - COMMAND INSTRUCTION
C00012 00006	"TF"     - COMMAND INSTRUCTION
C00013 00007	"CLEAR"  - COMMAND INSTRUCTION
C00016 00008	"LISTT"  - LISTS THE VALUES OF STORED TRANSFORMATION
C00019 00009	"LISTP"  - LISTS THE STEPS OF A USER PROGRAM
C00022 00010	"PUNCHT"&"PUNCHP" - SAME AS LISTT&LISTP TO PAPER TAPE
C00023 00011	"PROGS"  - LISTS THE NAMES OF ALL USER PROGRAMS
C00025 00012	"STATUS" - PRINTS THE CURRENT STATUS OF PROGRAM EXECUTION
C00028 00013	"FREE"   - COMMAND INSTRUCTION
C00030 00014	"EXEC"   - COMMAND INSTRUCTION
C00035 00015	"PROCEED","SNGSTP" - COMMAND INSTRUCTIONS
C00037 ENDMK
C⊗;
.TITLE FUNCTS

;START OF TOP LEVEL ARM PROGRAM

START:	RESET
	MOV 	#STKTOP,SP	;INITIALIZE STACK
   .IFZ LSI
	MOV	#PARVEC+2,PARVEC;ENABLE PARITY ERROR TRAPS
	MOV	#BPT,PARVEC+2
	MOV 	#1,PARCSR
   .ENDC
	MOV	#LOCK,R0	;TRANSFER EIS CONSTANTS FROM ROM TO RAM
	MOV	#CONS,R1
	MOV	#CONE-CONS/2,R3
	MOV	(R1)+,(R0)+
	SOB	R3,.-2
	MTPS	LOCK		;INITIALIZE PROCESSOR STATUS
	MOV	#CLKSER,@#CLKTRP;SET UP CLOCK VECTOR
	MOV	#KLOCK,@#CLKTRP+2
	MOV	#HELLO,SG	;TELL EVERYONE WHO WE ARE
	JSR	PC,INIT		;INITIALIZE?
	JSR	PC,CRLF
MAINL:	MOV	#QUERY,SG	;ASK FOR INSTRUCTION
	JSR	PC,TYPSTR
	MOV	#INBUF,SG	;READ IN A COMMAND INSTRUCTION
	JSR	PC,INSTR
	MOV	#FUNTAB,R0	;DECODE IT,NEED FUNCTION HASH TABLE
	MOV	#CMND,R1	;ONLY LOOK FOR TOP LEVEL COMMANDS
	JSR	PC,PUSARG
	BCC	GOTCOM		;BRANCH IF LEGAL COMMAND
	TST	R1		;TEST IF EMPTY STRING 
	BEQ	MAINL		;LOOP BACK IF EMPTY LINE
	JSR	PC,TYPERR 	;ELSE TYPE ERROR MESSAGE
	BR	MAINL
GOTCOM:	MOV	SP,R4		;PTR TO ARGUMENTS OF STACK
	JSR	PC,@(R0)+	;EXECUTE FUNCTION
	ADD	#MAXARG,SP	;CLEAR ARGUMENT LIST OFF STACK
	BR	MAINL

DONE:	MOV	#GOODBY,R1	;ALL DONE, STOP MONITOR
	JSR	PC,TYPERR
	ADD	#MAXARG+2,SP	;LEAVE STACK CLEAR
	MOV	#2,@#CLKTRP+2	;CLEAR CLOCK INTERRUPT VECTOR
	MOV	#CLKTRP+2,@#CLKTRP
	HLT

QUERY:	.ASCIZ	/./

;END OF TOP LEVEL SEQUENCE
;"HERE"   - COMMAND INSTRUCTION
 
;THIS ROUTINES SETS A GIVEN TRANSFORM EQUAL TO THE PRESENT POSITION
;OF THE ARM.  THE ONLY ARGUMENT REQUIRED FOR THIS FUNCTION IS A PTR
;TO THE TRANSFORMATION.

;REGISTERS USED:
;	ALL REGISTERS ARE AVAILABLE FOR USE

HERE:	MOV	(R4),R3		;GET PTR TO TRANS SYMBOL BLOCK
	JSR	PC,HERESB	;READ AND STORE POSITION
	BCC	.+6		;ERROR?
	JMP	@#TYPERR

	MOV	(R3),R0		;PERMIT EDITING OF TRANSFORM
	JMP	MODTRN


;END OF "HERE"
;"POINT"  - COMMAND INSTRUCTION
 
;THIS COMMAND IS USED FOR INITIALIZING AND EDITING THE X,Y,Z,O,A,T
;VALUES OF A SPECIFIED TRANSFORM.  THE TRANSFORMATION POINTER IS
;ASSUMED TO BE IN THE ARGUMENT LIST ON THE STACK.  IF THE TRANS IS TO
;BE SET EQUAL TO THE VALUE OF ANOTHER TRANSFORM, THIS SECOND TRANS PTR
;MUST ALSO BE ON THE STACK.

;REGISTERS USED:
;	ALL REGISTERS ARE AVAILABLE FOR USE

POINT:	CLR	R3
	MOV	(R4)+,R2	;PTR TO TRANS SYMBOL BLOCK
	MOV	(R2),R0		;PTR TO DATA
	BNE	10$
	MOV	#12.,R0		;GET A BLOCK OF F.S. IF NOT DEFINED
	JSR	PC,GETBLK
	BCS	45$		;NO ROOM?
	MOV	R0,(R2)		;SET PTR TO TRANS DATA AREA
	MOV	#SMPTRN,R3	;INIT. TRANSFORM TO REASONABLE POS
10$:	MOV	(R4),R1		;SET TRANS EQUAL TO ANOTHER TRANS?
	BEQ	20$
	MOV	(R1),R3		;YES
	BEQ	40$		;ERROR IF NO DATA
20$:	TST	R3		;INITIALIZE TRANS?
	BEQ	30$		;NO
	MOV	R0,R1
	MOV	#12.,R4
	MOV	(R3)+,(R1)+
	SOB	R4,.-2
30$:	JMP	@#MODTRN	;PERMIT EDITING OF TRANS

40$:	MOV	#NOTDAT,R1	;SIGNAL NO DATA FOUND WHEN EXPECTED
45$:	JMP	@#TYPERR


;END OF "POINT"
;"WHERE"  - COMMAND INSTRUCTION
 
;THIS COMMAND IS USED FOR TYPING OUT THE CURRENT ARM POSITION.  THE
;ARM POSITION IS PRINTED BOTH IN EULER ANGLES AND JOINT ANGLES.  THE
;HAND OPENING IS ALSO LISTED IN INCHES.  AS A SIDE AFFECT, "WHERE"
;UPDATES "CTRANS" WITH THE CURRENT ARM TRANSFORM.  NO ARGUMENTS ARE
;REQUIRED BY THIS ROUTINE.

;REGISTERS USED:
;	ALL REGISTERS ARE AVAILABLE FOR USE

WHERE:	CLR	R0		;READ JT. ANGLES/HAND OPENING
	MOV	#7,R1		;SEVEN CHANNELS IN ALL
	MOV	#JANGLE,R2
       	JSR	PC,ANGLES	;PUT INTO "JANGLE"
	BCC	WHER1 		;BRANCH IF NO ADC ERROR
	JSR	PC,TYPERR
	BR	WHEDNE		;EXIT
WHER1:	MOV     #HTRAN2,SG	;TYPE OUT THE COLUMN HEADER 
	JSR	PC,LINOUT
	MOV	#CTRANS,R0	;PUT CURRENT TRANSFORM IN HERE
	MOV	#JANGLE,R1	;GET JOINT ANGLES FROM HERE
	JSR	PC,UPDATE	;CONVERT JT. ANGLES TO TRANSFORM
	MOV	#CTRANS,R0	;TYPE OUT THIS TRANSFORM
      	JSR	PC,PTRANS
	MOV	#WHERC1,SG	;TYPE OUT JOINT ANGLES COLUMN HEADER
	JSR	PC,LINOUT
	MOV	#OUTBUF,SG	;CONVERT JOINT ANGLES TO ASCII
	MOV	#JANGLE,R2	;HERE ARE THE ANGLES
	MOV	#6,R3		;PRINT 6 ANGLES AND HAND OPENING
WHER2:	MOV	(R2)+,R0 	;GET AN ANGLE
	JSR	PC,PRTANG	;CONVERT TO ASCII
	MOVB	#40,(SG)+	;PUT IN A SPACE CHARACTER
	SOB	R3,WHER2
	MOV	(R2),R0		;CONVERT THE HAND OPENING TO INCHES
	JSR	PC,PRTDIS
	MOV	#OUTBUF,SG	;PRINT THE ASC STRING
	JSR	PC,LINOUT
WHEDNE:	RTS	PC

WHERC1:	.ASCII	/   JT 1    JT 2    JT 3    JT 4    JT 5    /
	.ASCIZ	/JT 6    HAND/
	.EVEN

;END OF "WHERE"
;"TF"     - COMMAND INSTRUCTION
 
;THIS ROUTINES INITIALIZES THE VALUE OF ONE TRANSFORM.  IT REQUIRES
;AS ITS ARGUMENTS, THE TRANSFORM NAME AND ITS 6 DEFINING VALUES.

;REGISTERS USED:
;	ALL REGISTERS ARE AVAILABLE FOR USE

TF:   	MOV	(R4)+,R2	;GET PTR TO TRANS SYMBOL BLOCK
	MOV	(R2),R0		;GET PTR TO DATA
	BNE	TF2
	MOV	#12.,R0		;GET A BLOCK OF F.S. IF NOT DEFINED
	JSR	PC,GETBLK
	BCC	.+6		;NO ROOM?
	JMP	@#TYPERR
	MOV	R0,(R2)		;SET PTR TO TRANS DATA AREA
TF2:	MOV	R4,R1		;CONVERT EULER ANGLES TO TRANFORM
	JMP	@#UNEUL 	;DO CONVERSION


;END OF "TF"
;"CLEAR"  - COMMAND INSTRUCTION
 
;THIS COMMAND IS USED FOR RE-INITIALIZING THE ARM PROGRAM.  IT DOES
;THIS BY ZEROING ALL VARIABLE WORDS FROM "ZAPSTR" TO "ZAPEND".  IT ALSO
;RESETS THE LOW CORE TRAP VECTORS.  NO ARGUMENT IS REQUIRED BY THIS
;ROUTINE, HOWEVER RE-CONFIRMATION OF THE CLEAR COMMAND IS REQUESTED.

;REGISTERS USED:
;	ALL REGISTERS ARE AVAILABLE FOR USE

CLEAR:	MOV	#SURE,SG	;REAFFIRM COMMAND REQUEST
	JSR	PC,INIT		;CLEAR IF REQUESTED
	MOV	#CLRFIN,SG	;TELL EVERYONE IT'S DONE
	BCC	.+6
	MOV	#CANCLR,SG	;CANCEL CLEAR COMMAND
	JMP	LINOUT

;SUBR TO INITIALIZE TRAP VECTORS AND ZAP AREA

INIT:	JSR	PC,TYPSTR	;INPUT RESPONSE
	MOV	#INBUF,SG
	JSR	PC,INSTR
	CMPB	#' ,(SG)+	;IGNOR LEADING SPACE CHARACTERS
	BEQ	.-4
	CMPB	#'Y,-1(SG)	;"Y" ?
	BNE	2$
	CMPB	#' ,(SG)+	;IGNOR TRAILING SPACE CHARACTERS
	BEQ	.-4
	TSTB	-1(SG)		;THIS SHOULD BE A NULL
	BNE	2$
   .IFZ LSI
	MOV	@#14,-(SP)	;SAVE DDT BPT
	MOV	@#16,-(SP)
   .ENDC
	MOV	#8*4,R0		;FILL LOW CORE TRAPS
	MOV	#8,R1		;NUMBER OF TRAPS
1$:	MOV	#HLT,-(R0)
	MOV	R0,R2
	MOV	R2,-(R0)
	SOB	R1,1$
   .IFZ LSI
	MOV	(SP)+,@#16
	MOV	(SP)+,@#14
   .ENDC
	MOV	#ZAPEND-ZAPSTR/2,R0	;NUMBER OF WORDS TO ZERO
	MOV	#ZAPSTR,R1	;START CLEARING AT THIS LOCATION
	CLR	(R1)+
	SOB	R0,.-2
	BR	.+4
2$:	SEC
	RTS	PC

SURE:	.ASCIZ	/ARE YOU SURE (Y,N)? /
CLRFIN:	.ASCIZ	/ARM PROGRAM RE-INITIALIZED, ALL FREE STORAGE RECLAIMED/
CANCLR:	.ASCIZ	/CLEAR COMMAND ABORTED/
	.EVEN

;END OF "CLEAR"
;"LISTT"  - LISTS THE VALUES OF STORED TRANSFORMATION

;LISTS UP TO EIGHT TRANSFORMATIONS THAT ARE SPECIFIED BY THE USER.
;IT IS ASSUMED THAT THE TRANSFORMATIONS SYMBOL BLOCK POINTERS ARE
;ON THE STACK.  IF NO TRANSFORMATIONS ARE SPECIFIED, ALL EXISTING
;TRANSFORMATIONS ARE LISTED.

;REGISTERS USED:
;	ALL REGISTERS ARE AVAILABLE FOR USE

LISTT:	MOV	#HTRANS,SG	;PRINT THE HEADER
	JSR	PC,LINOUT
	CLR	@#ISPNHT	;INDICATE "LISTT" INSTRUCTION

LSTSTR:	CLR	R3		;# OF TRANS' PRINTED
	MOV	#8.,R2		;LIMITED LIST OF 8 MAX
LISTT1:	MOV	(R4)+,R0
	BEQ	DNTPTR
	MOV	@#ISPNHT,R1	;PRINT ALL SPECIFIED TRANSFORMS
	JSR	PC,PTRTRN
	INC	R3		;ONE MORE TRANS PRINTED
DNTPTR:	JSR	PC,TICKLE	;ABORT?
	BCS	LSTTER
	SOB	R2,LISTT1
	TST	R3		;PRINT ALL TRANS' IF NONE SPECIFIED
	BNE	LSTDNE

LSTALL:	MOV	#32.,R2		;CHECK ALL 32. HASH BUCKETS FOR TRANS
	MOV	#VARTAB,R3	;PTR TO FIRST BUCKET
10$:	MOV	(R3)+,R4	;GET FIRST POINTER
	BEQ	40$
20$:	BITB	#TRANS,TYPBIT(R4)	;CHECK IF TRANS VARIABLE
	BEQ	30$
	MOV	R4,R0		;GOT A TRANS, PRINT IT
	MOV	@#ISPNHT,R1
	JSR	PC,PTRTRN
30$:	JSR	PC,TICKLE	;ABORT?
	BCS	LSTTER
	MOV	LINK(R4),R4	;NEXT ITEM IN BUCKET
	BNE	20$		
40$:	SOB	R2,10$		;REPEAT FOR ALL BUCKETS
	BR	LSTDNE

LSTTER:	JSR	PC,TYPERR
LSTDNE:	TST	@#ISPNHT	;NEED MORE BLANK TAPE?
	BEQ	.+6
	JSR	PC,NULLS
	RTS	PC

;END OF "LISTT"
;"LISTP"  - LISTS THE STEPS OF A USER PROGRAM

;LISTS THE SPECIFIED STEPS OF A USER PROGRAM.  IF NO FIRST STEP IS
;SPECIFIED, STEP ONE IS ASSUMED.  IF NO LAST STEP IS SPECIFIED,
;PRINTING IS CONTINUED UNTIL THE END OF THE PROGRAM IS ENCOUNTERED.
;THE ARGUMENTS FOR THIS ROUTINE ARE ASSUMED TO BE ON THE STACK IN THE
;FOLLOWING ASCENDING ORDER: PROGRAM PTR, 1ST STEP, LAST STEP.

;REGISTERS USED:
;	ALL REGISTERS ARE AVAILABLE FOR USE

LISTP:	CLR	@#ISPNHP	;INDICATE "LISTP"

LSPSTR:	MOV	(R4)+,R0	;PTR TO PROGRAM SYMBOL BLOCK
	MOV	R0,@#LPROG
	MOV	#LSTPMS,SG	;TYPE PROGRAM NAME
	JSR	PC,TYPSTR
	MOV	#OUTBUF,SG
	JSR	PC,PACNMS
	MOV	#OUTBUF,SG
	JSR	PC,LINOUT
	MOV	R0,R1		;PTR TO PROGRAM SYMBOL BLOCK
	TST	(R1)		;ANY STEPS DEFINED?
	BEQ	LSTPDN
	MOV	(R4)+,R2	;FIRST STEP NUMBER
	BGT	.+6
	MOV	#1,R2		;DEFAULT = STEP 1
	MOV	(R4)+,R3	;FINAL STEP NUMBER
	BGT	.+6
	MOV	#77777,R3	;DEFAULT = LAST PROGRAM STEP
	SUB	R2,R3		;NUMBER OF STEPS TO PRINT-1
	BGE	LISTP2
	MOV	#BADSTP,R1	;SIGNAL ERROR IF FINAL<FIRST
	BR	LSTPER
LISTP2:	INC	R3
       	MOV	R2,R4		;GET FIRST REQUESTED STEP
LISTP3:	MOV	(R1),R1
	BEQ	LSTPDN		;NOTHING TO DO IF PAST END
	SOB	R4,LISTP3
LISTP4:	MOV	R2,R0		;PRINT THE REQUESTED STEPS
	JSR	PC,PSTEP
	INC	R2		;INCREASE STEP NUMBER
	MOV	(R1),R1
	BEQ	LSTPDN		;DONE IF END OF PROGRAM
	JSR	PC,TICKLE	;ABORT?
	BCS	LSTPER
	SOB	R3,LISTP4
	BR	LSTPDN

LSTPER:	JSR	PC,TYPERR
LSTPDN:	JSR	PC,CRLF
	TST	@#ISPNHP	;NEED MORE BLANK TAPE?
	BEQ	.+6
	JSR	PC,NULLS
	RTS	PC

LSTPMS:	.ASCIZ	/DEFPRO /
	.EVEN

;END OF "LISTP"
;"PUNCHT"&"PUNCHP" - SAME AS LISTT&LISTP TO PAPER TAPE

;THESE ROUTINES ARE IDENTICAL TO "LISTT" AND "LISTP" EXCEPT THAT
;NO HEADERS ARE TYPED OUT AND INSTEAD NULL CHARACTERS ARE PRINTED
;BEFORE AND AFTER THE DATA TO PROVIDE SOME BLANK LEADER.

;REGISTERS USED:
;
;	ALL REGISTERS ARE AVAILABLE FOR USE

PUNCHT:	JSR	PC,NULLS	;PUNCH OUT A LEADER TAPE
	MOV	#-1,@#ISPNHT	;INDICATE PUNCHT COMMAND
	JMP	LSTSTR		;NOW JUST LIKE "LISTT"

PUNCHP:	JSR	PC,NULLS	;PUNCH OUT A LEADER TAPE
	MOV	#-1,@#ISPNHP	;INDICATE PUNCHT COMMAND
	JMP	LSPSTR		;NOW JUST LIKE "LISTP"

;END OF "PUNCHT"&"PUNCHP"
;"PROGS"  - LISTS THE NAMES OF ALL USER PROGRAMS

;THIS ROUTINE LISTS THE NAMES OF ALL USER PROGRAMS THAT HAVE AT
;LEAST ONE PROGRAM STEP DEFINED.  IT REQUIRES NO ARGMENTS.

;REGISTERS USED:
;	ALL REGISTERS ARE AVAILABLE FOR USE

PROGS: 	MOV	#32.,R2		;CHECK ALL 32. HASH BUCKETS FOR PROGS
	MOV	#VARTAB,R3	;PTR TO FIRST BUCKET
	MOV	#"  ,@#OUTBUF
1$:	MOV	(R3)+,R4	;GET FIRST POINTER
	BEQ	4$
2$:	BITB	#PROG,TYPBIT(R4);CHECK IF PROGRAM NAME
	BEQ	3$
	TST	(R4)		;ANY PROG STEPS DEFINED?
	BEQ	3$		;NO
	MOV	R4,R0		;GOT A PROGRAM NAME, PRINT IT
	MOV	#OUTBUF+2,SG
	JSR	PC,PACNMS
	MOV	#OUTBUF,SG
	JSR	PC,LINOUT
3$:	JSR	PC,TICKLE	;ABORT?
	BCS	PABORT
	MOV	LINK(R4),R4	;NEXT ITEM IN BUCKET
	BNE	2$		
4$:	SOB	R2,1$		;REPEAT FOR ALL BUCKETS
	BR	PROGDN

PABORT:	JSR	PC,TYPERR
PROGDN:	RTS	PC

;END OF "PROGS"
;"STATUS" - PRINTS THE CURRENT STATUS OF PROGRAM EXECUTION

;THIS ROQTINE LISTS THE LEVELS OF "GOSUB" CALLS THAT ARE NOW ACTIVE
;AND THE NUMBER OF PROGRAM LOKP EXECUTED AND THOSE REMAINING.

;BEGISTERS USED:
;	ALL REGISTERS ARE AVAILABLE FOR USE

STATUS:	MOV	#SUBSTK+2,R3	;SUBR STACK
	MOV	#STAHDR,SG	;PRINT HEADER
	JSR	PC,LINOUT
	MOV	#"  ,@#OUTBUF
1$:	MOV	#OUTBUF+2,SG
	MOV	-(R3),R0	;GET SUBR NAME
	BEQ	4$
	JSR	PC,PACNME	;SAVE IN OUTBUF
	MOV	-(R3),R2	;RETURN ADDR
	BEQ	3$
	MOV	(R0),R1		;COMPUTE STEP NUMBER
	CLR	R0
	BR	.+4
2$:	MOV	(R1),R1		;KEEP MOVING
	INC	R0
	CMP	R1,R2		;FOUND STEP?
	BNE	2$		;NO
	MOVB	#' ,(SG)+
	JSR	PC,PTSINT	;YES, CONVERT TO ASCII
3$:	MOV	#OUTBUF,SG
	JSR	PC,LINOUT
	CMP	R3,@#SUBPTR	;END OF LIST?
	BGT	1$		;NO
4$:	MOV	#LOPHDR,SG	;TYPE OUT NUMBER OF LOOPS EXECUTED
	JSR	PC,TYPSTR
	MOV	#OUTBUF,SG
	MOV	@#LOPCNT,R0
	BIC	#100000,R0
	JSR	PC,PTSINT
	MOV	#OUTBUF,SG
	JSR	PC,LINOUT
	MOV	#LOPHD2,SG	;TYPE OUT NUMBER OF LOOPS REMAINING
	JSR	PC,TYPSTR
	MOV	#INFMES,SG
	MOV	@#EXECNT,R0
	BMI	5$
	MOV	#OUTBUF,SG
	JSR	PC,PTSINT
	MOV	#OUTBUF,SG
5$:	JSR	PC,LINOUT
	RTS	PC

STAHDR:	.ASCIZ	/RTN   LAST STEP/
LOPHDR:	.ASCIZ	/
NUMBER OF LOOPS EXECUTED = /
LOPHD2:	.ASCIZ	/NUMBER OF LOOPS REMAINING = /
INFMES:	.ASCIZ	/INFINITE/
	.EVEN

;END OF "STATUS"
;"FREE"   - COMMAND INSTRUCTION
 
;THIS ROUTINE TYPES OUT THE AMOUNT OF FREE STORAGE SPACE THAT IS
;NOT CURRENTLY BEING USED.  NO ARGUMENTS ARE REQUIRED.

;REGISTERS USED:
;	ALL REGISTERS ARE AVAILABLE FOR USE

FREE:	CLR	R5		;NUMBER OF FREE BYTES
	MOV	#10000.,R0	;100% FREE?
	TST	@#FSPTR
	BEQ	ALLFRE		;YES
	MOV	#FREEST+2,R2	;START ADDING FROM HERE
	MOV	@#HICORE,R4	;END OF F.S.
FREELP:	MOV	(R2),R3		;NEXT BOUNDARY TAG
	BEQ	FREEER		;CAN'T EVER BE THIS
	BPL	MOREFR		;>0 INDICATES NOT BEING USED
	NEG	R3		;ON TO NEXT
	BR	NXTBLK
MOREFR:	ADD	R3,R5		;ADD TO FREE SUM
NXTBLK:	MOV	R2,R1		;CHECK FOR VALID BOUNDARY TAGS
	ADD	R3,R2
	CMP	(R1),-2(R2)	;HI=LOW?
	BNE	FREEER
	CMP	R4,R2		;END OF F.S.?
	BHI	FREELP
	SUB	#FREEST,R4	;TOTAL SIZE OF F.S AREA
	TST	-(R4)
	MUL	R5,R0		;COMPUTE PERCENTAGE FREE
	DIV	R4,R0
ALLFRE:	MOV	#FREMES,SG	;TYPE OUTPUT MESSAGE
	JSR	PC,TYPSTR
	MOV	#OUTBUF,SG	;CONVERT PERCENTAGE TO ASCII
	JSR	PC,PTSHUN
	MOVB	#45,(SG)+	;%
	CLRB	(SG)
	MOV	#OUTBUF,SG
	JSR	PC,LINOUT
	BR	FREDNE

FREEER:	MOV	#BADFRE,R1	;SAY F.S. AREA IN WRONG FORMAT
	JSR	PC,TYPERR

FREDNE:	RTS	PC

FREMES:	.ASCIZ	/UNUSED FREE STORAGE = /
	.EVEN

;END OF "FREE"
;"EXEC"   - COMMAND INSTRUCTION

;THIS COMMAND IS USED FOR INITIATING ARM MOTION PROGRAMS.  IT
;REQUIRES THREE ARGUMENTS:  A USER PROGRAM NAME, A LOOP COUNT, AND
;A STARTING STEP NUMBER FOR THE FIRST PASS.  IF THE PROGRAM NAME IS
;OMITTED, THE LAST PROGRAM EXECUTED IS AGAIN RUN.  IF THE COUNT IS
;MISSING, ONE PASS IS ASSUMED.  A PASS ENDS WHENEVER A "STOP"
;INSTRUCTION IS ENCOUNTERED.  FOR MULTIPLE PASS COMMANDS, THE STOP
;MESSAGE IS SUPPRESSED UNTIL THE FINAL PASS IS COMPLETED.
;IF THE STARTING STEP NUMBER IS OMITTED, EXECUTION BEGINS
;WITH THE FIRST PROGRAM INSTRUCTION.

;REGISTERS USED:
;	ALL REGISTERS ARE AVAILABLE FOR USE

EXEC:	CLR	@#ARMS		;CLEAR ALL FLAGS
	MOV	(R4)+,R2	;PROGRAM PTR
	BNE	1$
	MOV	#NOPROG,R1	;ERROR CODE IF NO PROGS EXECUTED YET
	MOV	@#SUBSTK,R2	;RE-TRY LAST PROGRAM
	BNE	1$
	JMP	EXECER
1$:	MOV	R2,@#SUBSTK	;SET-UP SUBROUTINE STACK
	MOV	#SUBSTK-2,@#SUBPTR
       	MOV	#NULPRG,R1	;ERROR MESSAGE FOR NO PROGRAM STEPS
	MOV	(R2),R2		;PTR TO FIRST STEP TO EXECUTE
	BNE	.+6
	JMP	EXECER
	MOV	(R4)+,R0
	BNE	.+6
	MOV	#1,R0		;DEFAULT = 1 PASS
	MOV	R0,@#EXECNT	;PASS COUNT
	CLR	@#LOPCNT
	MOV	(R4)+,R0	;GET STARTING STEP NUMBER
	DEC	R0
	BLE	3$		;START WITH FIRST STEP
2$:	MOV	(R2),R2		;MOVE DOWN TO STARTING STEP
	BEQ	.+4		;CANT MOVE PAST END
	SOB	R0,2$
3$:	MOV	R2,@SUBPTR	;SAVE PTR TO FIRST STEP TO EXEC
	CLR	@#NSPEED	;NORMAL SPEED
	CLR	@#PSPEED
	CLR	@#CONFIG	;NO SPECIAL CONFIGURATION
	CLR	@#MODES		;NO PARTICULAR SERVO MODES
	CLR	@#PMODES
	CLR	@#JTBITS	;NO SPECIAL JT IN TOLERANCE BITS


EXECST:	CLR	R0		;READ CURRENT JT. ANGLES+HAND OPENING
	MOV	#7,R1		;SEVEN CHANNELS IN ALL
	MOV	#DANGLE,R2	;SAVE IN HERE
	JSR	PC,ANGLES
	BCS	EXECER		;BRANCH IF ADC DEAD
	MOV	#DACVAL,R0	;INIT. DACS TO THE CURRENT POSITION
	JSR	PC,TODAC
	JSR	PC,REFRESH
	MOV	#NEWDAC,R0	;NEWDAC ← DACVAL
	MOV	#DACVAL,R1
	MOV	#7,R2
1$:	MOV	(R1)+,(R0)+
	SOB	R2,1$
	CLR	@#BRAKES	;RESET ALL HARDWARE BITS
	MOV	#SWAIT,@#WAITNG	;SET START WAIT COUNT
	MTPS	UNLOCK		;LET THE CLOCK INTERRUPT
	CLKON
	MOV	#DANGLE,R0	;DETERMINE CURRENT ARM CONFIGURATION
	JSR	PC,FLAGS
	MOV	@SUBPTR,R4	;ADDR. OF STEP TO EXECUTE
	ADD	#2,@#SUBPTR
	BR	TSTSTP

TOPER:	INC	@#EXECNT
TOTOP:	MOV	@SUBSTK,R3	;RESTART AT TOP OF PROGRAM
	MOV	#SUBSTK,@#SUBPTR;RESET SUBR CALL STACK
GOSTEP:	MOV	(R3)+,R4	;NEXT STEP TO EXECUTE
	MOV	(R3)+,R1	;PTR TO MOTION FUNCTION
	BIC	#1,R1		;DELETE ANY LABEL MARKERS
	JSR	PC,@(R1)+	;EXECUTE MOTION FUNCTION
	TST	@#ARMS  	;ANY ERROR BITS SET?
	BNE	TELSTP		;YES
TSTSTP:	MOV	R4,R3		;END OF PASS?
	BNE	GOSTEP
	INC	@#LOPCNT
	DEC	@#EXECNT	;LAST PASS?
	BGT	TOTOP 
	BMI	TOPER		;INFINITE LOOP
	MOV	#FINI,R1	;SIGNAL ALL DONE
	CLR	@#ARMS
	BR	.+6

TELSTP:	MOV	#UHALT,R1	;PRINT ERROR MESSAGE

	SUB	#2,@#SUBPTR	;SAVE PTR TO NEXT STEP
	MOV	R4,@SUBPTR

EXECER:	MOV	#-1,R0		;SET ALL OF THE BRAKES
	JSR	PC,SETBRK
	CLKOFF			;STOP THE CLOCK INTERRUPTS
	MTPS	LOCK
	JMP	TYPERR		;TYPE ERROR AND RETURN


;END OF "EXEC"
;"PROCEED","SNGSTP" - COMMAND INSTRUCTIONS

;THESE COMMANDS ARE USED FOR CONTINUING THE EXECUTION OF AN ARM
;PROGRAM AFTER IT HAS BEEN TERMINATED BY EITHER A "PAUSE" COMMAND
;OR ANY ONE OF A NUMBER OF ERROR CONDITIONS.  ONLY TERMINATION
;CONDITIONS THAT LEAVE THE "CANPRO" BIT IN THE ARM STATUS WORD
;( "ARMS" ) ON PERMIT THESE FUNCTIONS TO OPERATE.  NO ARGUMENTS
;ARE REQUIRED BY THESE ROUTINES.

;REGISTERS USED:
;	ALL REGISTERS AVAILABLE FOR USE

PROCED:	CLR	R0		;ARMS←0 IF CAN PROCEED
	MOV	#CNTPRO,R1	;ERROR MESSAGE OTHERWISE
	BR	TRYGO

SNGSTP:	MOV	#CANPRO,R0	;ARMS←CANPRO IF CAN PROCEED
	MOV	#CNTSGS,R1

TRYGO:	BIT	#CANPRO,ARMS	;CHECK IF PROCEEDING PERMITTED
	BEQ	NOPROC		;BRANCH IF NOT OK
	MOV	R0,@#ARMS
	JMP	EXECST		;GO CONTINUE EXECUTION

NOPROC:	JMP	TYPERR		;ELSE TYPE ERROR MESSAGE


;END OF "PROCED","SNGSTP"